perm filename Q3.F4[SAB,LCS] blob
sn#356901 filedate 1978-05-22 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 DIMENSION X(14),Y(14),INK(14),IBUF(5000)
C00004 ENDMK
Cā;
DIMENSION X(14),Y(14),INK(14),IBUF(5000)
COMMON /FAC/JFAC,KFAC
DATA X/0.,.7,.7,.6,1.8,2.6,3.1,3.9,3.5,3.4,4.5,4.8,5.,5.3/,
1 Y/0.,.5,.3,.1,.5,-.3,-.8,.5,.6,.8,1.1,.7,1.,1./,
1 INK/3,3,3,2,2,2,3,2,2,3,2,2,2,2/
CC 1 INK/3,2,3,2,2,2,3,2,2,3,2,2,2,2/
TYPE 1
ACCEPT 2,JFAC,KFAC
IF(JFAC.EQ.0)JFAC=100
IF(KFAC.EQ.0)KFAC=100
CALL PLOT (15.,14.75,-3)
CX=0.0
CY=0.0
CC ANG=5.
ANG=1.5
CC KK=120
JJ1=1
DO 30 JJ=1,120
TYPE 2,JJ1
KK= 50
CC DO 30 JJ=1,120
CALL PLOTS (IBUF,5000,1)
KK=KK+1
N=1
DO 20 J=1,200
CC DO 20 J=JJ,KK
IF(JJ1.EQ.11.OR.
1JJ1.EQ.25.OR.
1JJ1.EQ.34.OR.JJ1.EQ.50.OR.JJ1.EQ.51.OR.JJ1.EQ.54.OR.
1JJ1.EQ.57.OR.JJ1.EQ.66.OR.JJ1.EQ.74)GO TO 12
GO TO 20
12 DO 10 K=1,14
CALL PLOT (X(K),Y(K),INK(K))
10 CONTINUE
CALL ROTATE (X,Y,14,CX,CY,ANG)
N=N+1
ANG=ANG+.02
CC JFAC=JFAC+1
CC KFAC=KFAC+1
CC L=J-10*(J/10)
CC IF(L.EQ.0)PAUSE
20 CONTINUE
JJ1=JJ1+1
PAUSE
30 CONTINUE
CALL PLOT (0.0,-30.,-3)
CALL PLOT(0.0,0.0,999)
STOP
1 FORMAT(' TYPE X FACTOR AND Y FACTOR '$)
2 FORMAT(2I)
END